{ Image Macros for intensity calculations on Photometrics CCD images } {Globals} var {16 to 8 conversion info} ymin, ymax, {pid numbers for images} customLUTpid, smoothPid, kernelPid, raw16Pid, rawWidth, rawHeight, proc16Pid, proc8Pid, procXmin, procXmax, temp16Pid, flagPid, mask1Pid, maskWidth, maskHeight, seg8aPid, seg8bPid, dark16Pid, unif16Pid, {segmentation} fore, {YES/NO parameters} skipFlat, {nonzero = skip flat field correction} skipMedian, {nonzero = skip median filter step} skipSmooth, {nonzero = skip smooth step} {smooth kernel parameters} {flat field ratio constant} {fix for choosePic/selectPic bug which leaves LUT wrong} {before doing a selectPic, do choosePic(lastSelectPid)} {at start of macro, note lastSelectPid} {after each select, note lastSelectPid} lastSelectPid : integer; {initialize/restore globals} begin requiresUser('Pixel16u',2); requiresUser('GetPutPixel',1); requiresUser('timer',1); requiresUser('utilities',1); requiresUser('markup',1); kernelPid := getMemo('kernelPid'); if not pidExists(kernelPid) then begin if getMemo('openedKernel') <> 0 then begin putMessage('please do not close standardBkgKernel window'); putMessage('now you have to find it again'); end; setMemo('openedKernel',1); Open('standardBkgKernel'); kernelPid := pidNumber; SetMemo('kernelPid', kernelPid); end; ymin := getMemo('ymin'); ymax := getMemo('ymax'); {pid numbers} customLUTpid := getMemo('customLUTpid'); smoothPid := getMemo('smoothPid'); raw16Pid := getMemo('raw16Pid'); rawWidth := getMemo('rawWidth'); rawHeight := getMemo('rawHeight'); proc16Pid := getMemo('proc16Pid'); temp16Pid := getMemo('temp16Pid'); flagPid := getMemo('flagPid'); mask1Pid := getMemo('mask1Pid'); maskWidth := getMemo('maskWidth'); maskHeight := getMemo('maskHeight'); proc8Pid := getMemo('proc8Pid'); procXmin := getMemo('procXmin'); procXmax := getMemo('procXmax'); seg8aPid := getMemo('seg8aPid'); seg8bPid := getMemo('seg8bPid'); dark16Pid := getMemo('dark16Pid'); unif16Pid := getMemo('unif16Pid'); fore := getMemo('fore'); if fore < 1 then fore := 1; if fore > 250 then fore := 250; setMemo('fore',fore); SetBackgroundColor(0); SetForeGroundColor(255); end; {selectPic(pidNumber) is needed before choosePic/copy in case front} {window is Map or Histogram. But selectPic(pidNumber) clears threshold.} procedure fixCopyBug; var lower, upper: integer; begin lastSelectPid := pidNumber; if pidExists(lastSelectPid) then begin getThreshold(lower, upper); selectPic(pidNumber); if upper = 255 then setThreshold(lower) else setDensitySlice(lower, upper); end; end; {use choosePic to go back to the "right" image before selectPic} {to a new image. This should be done in the Pascal code.} procedure selectPicBugFix(pid: integer); begin if pidExists(lastSelectPid) then choosePic(lastSelectPid); selectPic(pid); lastSelectPid := pidNumber; end; procedure disposePicBugFix(pid: integer); begin if pidExists(lastSelectPid) then choosePic(lastSelectPid); selectPic(pid); dispose; lastSelectPid := pidNumber; end; {also, put this code before and after every MakeNewWindow: if pidExists(lastSelectPid) then choosePic(lastSelectPid); MakeNewWindow(name); lastSelectPid := pidNumber; } { Procedure: } { create uniform image from a series of data images. } { import dark image. } { import data image. } { flat field correction. } { reduce noise and smooth. } { convert to 8 bit with automatic scaling. } { adjust 8 bit scaling. } { threshold } { use wand tool to select a series of fragments. } { after each wand click, invoke macro to define the segment } { (fills roi on segment image with segment number)} { and a separate macro to assign the segment to a class } { (places class number into array indexed by segment number)} { (different macro for each class)} { use wand tool to select any nearby bright spots (dirt) } { invoke macro to define dirt segment } { circular dilate segments. } { copy the segments to another image, convert to one value, dilate more, } { subtract to produce background segment definition } { measure each segment in 16 bit data for sum, area, standard deviation, min, max} { Use "analyze particles" command on 8 bit segment image to find area, coordinates, seg number} { output to spreadsheet format text window: } { image name, top left coordinates, area, sum, standard deviation. } { also need way to identify values for internal standard} {status window: next segment number} procedure checkKernelPid; begin selectPicBugFix(pidNumber); if not pidExists(kernelPid) then begin putMessage('please do not close standardBkgKernel window'); putMessage('now you have to find standardBkgKernel again'); Open('standardBkgKernel'); kernelPid := pidNumber; SetMemo('kernelPid', kernelPid); end; end; procedure autoDispose(p); begin if pidExists(p) then begin disposePicBugFix(p); end; end; procedure createSmoothKernel; var x, y: integer; sum: real; begin RequiresUser('getputpixel', 1); AutoDispose(smoothPid); SaveState; SetNewSize(kw * 4, kh + 1); if pidExists(lastSelectPid) then choosePic(lastSelectPid); MakeNewWindow('kernel ', kx : 0, 'x ', ky : 0, 'y ', kw : 0, 'w ', kh : 0, 'h'); smoothPid := pidNumber; SetMemo('smoothPid', smoothPid); RestoreState; putPixel(0, 0, kx); putPixel(1, 0, ky); putPixel(2, 0, kw); putPixel(3, 0, kh); sum := 0.0; for x := -kx to kw - kx - 1 do begin for y := -ky to kh - ky - 1 do begin sum := sum + exp(-sqrt(sqr(x) + sqr(y))); end; end; sum := 32000.0 / sum; {nearly maximum before overflow on 65535 pixel} for x := -kx to kw - kx - 1 do begin for y := -ky to kh - ky - 1 do begin putPixel32s(smoothPid, x + kx, y + ky + 1, sum * exp(-sqrt(sqr(x) + sqr(y)))); end; end; sum := 0.0; for x := -kx to kw - kx - 1 do begin for y := -ky to kh - ky - 1 do begin sum := sum + getPixel32s(smoothPid, x + kx, y + ky + 1); end; end; showmessage('kernel sum = ', sum); selectPicBugFix(smoothPid); MakeRoi(0, 1, kw * 4, kh); end; procedure stdSmooth; var kx, ky, kw, kh: integer; begin kx := 1; ky := 1; kw := 3; kh := 3; createSmoothKernel; end; macro 'Create standard 3x3 smoothing kernel'; begin fixCopyBug; stdSmooth; end; macro 'Create arbitrary smoothing kernel'; var kx, ky, kw, kh: integer; begin fixCopyBug; kw := GetNumber('kernel width',5); kh := GetNumber('kernel height',5); kx := GetNumber('kernel x center',kw div 2); ky := GetNumber('kernel y center',kh div 2); createSmoothKernel; end; procedure setMaskSize; var skx, sky, skw, skh: integer; kx, ky, kw, kh: integer; kmin, kdelta, knum, koverlap: integer; front: integer; begin front := pidNumber; {find size of smoothing kernel} ChoosePic(smoothPid); skx := getPixel(0, 0); sky := getPixel(1, 0); skw := getPixel(2, 0); skh := getPixel(3, 0); {find size of background kernel} CheckKernelPid; ChoosePic(kernelPid); kmin := getPixel(0, 0); kdelta := getPixel(1, 0); knum := getPixel(2, 0); koverlap := getPixel(3, 0); kx := kmin + kdelta * (knum - 1); ky := kmin + kdelta * (knum - 1); kw := kx * 2 + 1; kh := ky * 2 + 1; {choose larger kernel} if kw < skw then kw := skw; if kh < skh then kh := skh; MakeRoi(0, 1, kw * 4, kh); maskWidth := rawWidth + kw - 1; maskHeight := rawHeight + kh - 1; SetMemo('maskWidth',maskWidth); SetMemo('maskHeight',maskHeight); ChoosePic(front); end; procedure forceROIWithin; var left, top, rwidth, rheight, iwidth, iheight: integer; begin GetPicSize(iwidth,iheight); GetRoi(left,top,rwidth,rheight); if rwidth = 0 then selectAll; {this fixes most cases} GetRoi(left,top,rwidth,rheight); if (left < 0) or (top < 0) or (left + rwidth > iwidth) or (top + rheight > iheight) then begin putmessage('ROI must not extend outside image'); exit; {make ROI doesn't hack it if ROI wasn't rectangular...} if left < 0 then begin rwidth := rwidth + left; left := 0; end; if top < 0 then begin rheight := rheight + top; top := 0; end; if left + rwidth > iwidth then begin rwidth := iwidth - left; end; if top + rheight > iheight then begin rheight := iheight - top; end; makeroi(left,top,rwidth,rheight); end; end; procedure forceUncalib; begin choosePic(proc8Pid); if Calibrated then begin selectAll; copy; disposePicBugFix(proc8Pid); SaveState; setNewSize(rawWidth, rawHeight); if pidExists(lastSelectPid) then choosePic(lastSelectPid); makeNewWindow('Processed 8 bit image'); lastSelectPid := pidNumber; proc8Pid := pidNumber; setMemo('proc8Pid',proc8Pid); RestoreState; Paste; KillRoi; end; SelectPicBugFix(proc8Pid); end; {adjust xmin/xmax using mean ± stdev} procedure enhanceStdev; var mean, sigma, coef: real; begin choosePic(proc16Pid); KillROI; choosePic(proc8Pid); forceROIWithin; forceUncalib; KillROI; coef := (procXmax - procXmin + 1) / (ymax - ymin + 1); {might not work if coef < 0???} linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax); Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid); RestoreRoi; {take mean & stdev over ROI of 8 bit image} SaveState; SetOptions('Area,Mean,Std. Dev.,User1,User2'); Measure; RestoreState; {does not restore option settings???} mean := (rmean[rCount]-ymin) * coef + procXmin + coef / 2; sigma := rStdDev[rCount] * coef + coef / 2; ruser1[rCount] := coef; ruser2[rCount] := mean; {serious round off errors happen when sigma < coef } {so that the mean is not known well enough, } {image comes out white or black} if sigma < coef then sigma := coef; {SetCounter(rCount - 1);} procXmin := mean - 2*sigma; {this needs to be an adjustable parameter} procXmax := mean + 4*sigma; SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); end; {display 16 bit data into the 8 bit image using specified xmin/xmax} procedure show16; var lower, upper: integer; begin choosePic(proc16Pid); KillROI; choosePic(proc8Pid); forceROIWithin; KillROI; linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax); Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid); RestoreRoi; selectPicBugFix(proc8Pid); GetThresholds(lower, upper); ShowMessage(procXmin,' min\',procXmax,' max\',lower,' lower\',upper,' upper\'); end; macro 'Set 8 bit display range'; begin fixCopyBug; ymin := getnumber('gray level for smallest pixel value',ymin); ymax := getnumber('gray level for largest pixel value',ymax); SetMemo('ymin',ymin); SetMemo('ymax',ymax); end; procedure swapTemp16; var temp: integer; begin temp := temp16Pid; temp16Pid := proc16Pid; proc16Pid := temp; temp := pidNumber; choosePic(proc16Pid); SetPicName('Processed 16 bit image'); killROI; choosePic(temp16Pid); SetPicName('Temporary 16 bit image'); killROI; choosePic(temp); end; procedure hide8image; var width, height: integer; begin selectPicBugFix(proc8Pid); setDensitySlice(0,0); setforegroundcolor(255); setbackgroundcolor(0); selectAll; clear; getPicSize(width, height); moveto(width div 3, height div 3); writeln('Press 8 to display image'); end; procedure checkSize(p,w,h: integer); var width, height, front: integer; begin if pidExists(p) then begin front := pidNumber; choosePic(p); getPicSize(width, height); choosePic(front); if (width <> w) or (height <> h) then disposePicBugFix(p); end; end; {if the scratch windows are wrong size or missing, create them} procedure makeScratchIfNeed; var width, height: integer; begin selectPicBugFix(pidNumber); saveState; if (ymin = 0) and (ymax = 0) then begin ymin := 1; ymax := 254; end; if (ymin < 0) or (ymin > 255) then ymin := 1; if (ymax < 0) or (ymax > 255) then ymax := 254; if ymin > ymax then begin ymin := 1; ymax := 254; end; SetMemo('ymin',ymin); SetMemo('ymax',ymax); if not pidExists(customlutPid) then begin setNewSize(256,256); makeNewWindow('custom LUT'); lastSelectPid := pidNumber; SelectAll; KillRoi; customLUTpid := pidNumber; SetMemo('customLUTpid',customLUTpid); end; linLUT16uto8(customLUTpid, 0, 65535, ymin, ymax); if not pidExists(smoothPid) then begin stdSmooth; end; checkKernelPid; if not pidExists(raw16Pid) then begin putMessage('makeScratch no raw16'); exit; end; choosePic(raw16Pid); getPicSize(width, height); rawWidth := (width div 4) * 2; rawHeight := height; setMemo('rawWidth',rawWidth); setMemo('rawHeight',rawHeight); if rawWidth * 2 <> width then begin putMessage('makeScratch raw width not multiple of 4'); exit; end; checkSize(proc16Pid,rawWidth * 2,rawHeight); if not pidExists(proc16Pid) then begin setNewSize(rawWidth * 2, rawHeight); makeNewWindow('Processed 16 bit image'); lastSelectPid := pidNumber; SelectAll; KillRoi; proc16Pid := pidNumber; SetMemo('proc16Pid',proc16Pid); end; checkSize(temp16Pid,rawWidth * 2,rawHeight); if not pidExists(temp16Pid) then begin setNewSize(rawWidth * 2, rawHeight); makeNewWindow('Temporary 16 bit image'); lastSelectPid := pidNumber; SelectAll; KillRoi; temp16Pid := pidNumber; SetMemo('temp16Pid',temp16Pid); end; checkSize(dark16Pid,rawWidth * 2,rawHeight); if not pidExists(dark16Pid) then begin setNewSize(rawWidth * 2, rawHeight); makeNewWindow('Dark 16 bit image'); lastSelectPid := pidNumber; SelectAll; KillRoi; dark16Pid := pidNumber; SetMemo('dark16Pid',dark16Pid); end; checkSize(unif16Pid,rawWidth * 2,rawHeight); if not pidExists(unif16Pid) then begin setNewSize(rawWidth * 2, rawHeight); makeNewWindow('Uniform 16 bit image'); lastSelectPid := pidNumber; SelectAll; KillRoi; unif16Pid := pidNumber; SetMemo('unif16Pid',unif16Pid); end; checkSize(flagPid,rawWidth,rawHeight); if not pidExists(flagPid) then begin setNewSize(rawWidth, rawHeight); makeNewWindow('smoothing flag image'); lastSelectPid := pidNumber; SelectAll; KillRoi; flagPid := pidNumber; SetMemo('flagPid',flagPid); end; setMaskSize; checkSize(mask1Pid,maskWidth,maskHeight); if not pidExists(mask1Pid) then begin setNewSize(maskWidth, maskHeight); makeNewWindow('smoothing mask image 1'); lastSelectPid := pidNumber; SelectAll; KillRoi; mask1Pid := pidNumber; SetMemo('mask1Pid',mask1Pid); end; checkSize(proc8Pid,rawWidth,rawHeight); if not pidExists(proc8Pid) then begin setNewSize(rawWidth, rawHeight); makeNewWindow('Processed 8 bit image'); lastSelectPid := pidNumber; SelectAll; KillRoi; proc8Pid := pidNumber; setMemo('proc8Pid',proc8Pid); end; checkSize(seg8aPid,rawWidth,rawHeight); if not pidExists(seg8aPid) then begin setNewSize(rawWidth, rawHeight); makeNewWindow('Segments A'); lastSelectPid := pidNumber; SelectAll; KillRoi; seg8aPid := pidNumber; setMemo('seg8aPid',seg8aPid); end; checkSize(seg8bPid,rawWidth,rawHeight); if not pidExists(seg8bPid) then begin setNewSize(rawWidth, rawHeight); makeNewWindow('Segments B'); lastSelectPid := pidNumber; SelectAll; KillRoi; seg8bPid := pidNumber; setMemo('seg8bPid',seg8bPid); end; restoreState; end; procedure copyRawToProc; begin choosePic(raw16Pid); selectAll; copy; killRoi; choosePic(proc16Pid); selectAll; paste; killRoi; end; { import arbitrary IPLab image: if (getpixel(0,0) <> ord('2')) or (getpixel(1,0) <> ord('.')) or (getpixel(2,0) <> ord('3')) or (getpixel(3,0) <> ord('a')) or (getpixel(4,0) <> 0) or (getpixel(5,0) <> 1) {short int} then else width := ((getpixel(6,0) * 256 + getpixel(7,0)) * 256 + getpixel(8,0)) * 256 + getpixel(9,0); height := ((getpixel(10,0) * 256 + getpixel(11,0)) * 256 + getpixel(12,0)) * 256 + getpixel(13,0); offset := 2120; } {if there is no raw data image, import one} procedure importIfNeed; var origPid: integer; begin origPid := 0; if not pidExists(raw16Pid) then begin SaveState; SetImport('8-bits,Custom'); SetCustom(2634,1034,2124); Import(''); origPid := pidNumber; {MakeNewWindow will not make odd width windows.} {Therefore, 16 bit images must be even # pixels wide} {or width multiple of 4} SetNewSize(2632,1032); MakeRoi(0, 2, 2632,1032); Copy; MakeNewWindow(GetPicName); raw16Pid := pidNumber; SetMemo('raw16Pid',raw16Pid); Paste; KillROI; disposePicBugFix(origPid); RestoreState; end; makeScratchIfNeed; if origPid <> 0 then begin CopyRawToProc; end; end; macro '[1] copy proc to dark image'; begin fixCopyBug; choosePic(proc16Pid); selectAll; copy; killRoi; choosePic(dark16Pid); selectAll; paste; killRoi; selectPicBugFix(proc8Pid); end; macro '[2] copy proc to uniform image'; begin fixCopyBug; choosePic(proc16Pid); selectAll; copy; killRoi; choosePic(unif16Pid); selectAll; paste; killRoi; selectPicBugFix(proc8Pid); end; macro '[d] subtract dark image'; begin fixCopyBug; choosePic(proc16Pid); killROI; choosePic(temp16Pid); killROI; choosePic(dark16Pid); killROI; sub16u(proc16Pid,dark16Pid,temp16Pid); swapTemp16; hide8Image; writeln('subtract dark'); end; macro '[f] flat field -- divide by uniform image'; begin fixCopyBug; choosePic(proc16Pid); killROI; choosePic(temp16Pid); killROI; choosePic(unif16Pid); killROI; ratio16u(proc16Pid,unif16Pid,temp16Pid,32768); swapTemp16; hide8Image; writeln('divide by uniform'); end; {macro 'include median filter step'; macro 'skip median filter step'; macro 'include smoothing step'; macro 'skip smoothing step'; macro 'include flat field step'; macro 'skip flat field step';} macro '[a] start over from raw image'; begin fixCopyBug; importIfNeed; CopyRawToProc; hide8Image; writeln('raw data'); end; macro '[z] undo last 16 bit transform'; begin fixCopyBug; swapTemp16; hide8Image; writeln('undo'); end; macro '[r]reduce noise'; begin fixCopyBug; {actually only need to copy the border} choosePic(proc16Pid); selectAll; copy; killRoi; choosePic(temp16Pid); selectAll; paste; {end copy} choosePic(proc16Pid); makeRoi(2,1,(rawWidth-2)*2,rawHeight-2); choosePic(temp16Pid); makeRoi(2,1,(rawWidth-2)*2,rawHeight-2); median16u(proc16Pid,temp16Pid); choosePic(proc16Pid); killROI; choosePic(temp16Pid); killROI; swapTemp16; hide8Image; writeln('reduce noise'); end; macro 'radial median filter'; var radius: real; r: integer; begin fixCopyBug; radius := getNumber('radius',10); r := round(radius + 0.5); {actually only need to copy the border} choosePic(proc16Pid); selectAll; copy; killRoi; choosePic(temp16Pid); selectAll; paste; killRoi; {end copy} choosePic(proc16Pid); makeRoi(2*r,r,(rawWidth-2*r)*2,rawHeight-2*r); choosePic(temp16Pid); makeRoi(2*r,r,(rawWidth-2*r)*2,rawHeight-2*r); radMedian16u(proc16Pid,temp16Pid,radius); choosePic(proc16Pid); killROI; choosePic(temp16Pid); killROI; swapTemp16; hide8Image; writeln('radial median filter'); end; macro '[m]min spatial filter'; begin fixCopyBug; choosePic(proc16Pid); makeRoi(2,1,(rawWidth-2)*2,rawHeight-2); choosePic(temp16Pid); makeRoi(2,1,(rawWidth-2)*2,rawHeight-2); minspat16u(proc16Pid,temp16Pid); choosePic(proc16Pid); killROI; choosePic(temp16Pid); killROI; swapTemp16; hide8Image; writeln('min spatial'); end; macro '[s] smooth'; var kx, ky, kw, kh: integer; begin fixCopyBug; SetBackgroundColor(0); ChoosePic(proc16Pid); killRoi; ChoosePic(temp16Pid); killRoi; ChoosePic(smoothPid); kx := getPixel(0, 0); ky := getPixel(1, 0); kw := getPixel(2, 0); kh := getPixel(3, 0); MakeRoi(0, 1, kw * 4, kh); ChoosePic(flagPid); SelectAll; Clear; KillRoi; ChoosePic(mask1Pid); MakeRoi(kx, ky, rawWidth, rawHeight); Clear; SetForegroundColor(255); MakeRoi(0, 0, kx, rawHeight + kh); Fill; MakeRoi(kx + rawWidth, 0, kw - kx - 1, rawHeight + kh); Fill; MakeRoi(kx, 0, rawWidth, ky); Fill; MakeRoi(kx, ky + rawHeight, rawWidth, kh - ky - 1); Fill; {Mask image must have an ROI same size as image and} {with borders matching kernel, thus:} MakeRoi(kx, ky, rawWidth, rawHeight); Convolve16u(flagPid, proc16Pid, smoothPid, kx, ky, mask1Pid, temp16Pid); swapTemp16; hide8Image; writeln('smooth'); end; macro 'Copy 8 bit image to seg8b and make binary'; var lower, upper: integer; begin fixCopyBug; ChoosePic(proc8Pid); GetThresholds(lower, upper); SelectAll; Copy; ChoosePic(seg8bPid); SelectAll; Paste; if upper = 255 then begin SetThreshold(lower); end else begin SetDensitySlice(lower,upper); end; MakeBinary; selectPicBugFix(seg8bPid); end macro 'Masked smooth against seg8b'; var kx, ky, kw, kh: integer; kmin, kdelta, knum, koverlap: integer; k, hist0, yb: integer; begin fixCopyBug; hide8Image; writeln('starting masked smooth'); SetBackgroundColor(0); {Use the background kernel not smoothing kernel} ChoosePic(kernelPid); kmin := getPixel(0, 0); kdelta := getPixel(1, 0); knum := getPixel(2, 0); koverlap := getPixel(3, 0); kx := kmin + kdelta * (knum - 1); ky := kmin + kdelta * (knum - 1); kw := kx * 2 + 1; kh := ky * 2 + 1; MakeRoi(0, 1, kw * 4, kh); ChoosePic(flagPid); SelectAll; Clear; KillRoi; ChoosePic(proc16Pid); KillRoi; ChoosePic(temp16Pid); KillRoi; ChoosePic(seg8bPid); MakeRoi(0, 0, rawWidth, rawHeight); Copy; ChoosePic(mask1Pid); MakeRoi(kx, ky, rawWidth, rawHeight); Paste; SetForegroundColor(255); MakeRoi(0, 0, kx, rawHeight + kh); Fill; MakeRoi(kx + rawWidth, 0, kw - kx - 1, rawHeight + kh); Fill; MakeRoi(kx, 0, rawWidth, ky); Fill; MakeRoi(kx, ky + rawHeight, rawWidth, kh - ky - 1); Fill; {Mask image must have an ROI same size as image and} {with borders matching kernel, thus:} MakeRoi(kx, ky, rawWidth, rawHeight); ChoosePic(flagPid); MakeRoi(0,0,rawWidth,rawHeight); {in case rawWidth is odd, actual width is even} hist0 := 1; kx := kmin; ky := kmin; yb := 1; SetOptions('User1,User2'); {turn off unneeded measurements} for k := 1 to knum do begin kw := kx * 2 + 1; kh := ky * 2 + 1; if hist0 <> 0 then begin ChoosePic(kernelPid); MakeRoi(0, yb, kw * 4, kh); Convolve16u(flagPid, proc16Pid, kernelPid, kx, ky, mask1Pid, temp16Pid); {Check for complete} ChoosePic(flagPid); SelectAll; {Recalculate any pixels which depended on less than 4 } ChangeValues(1, 4, 0); Measure; hist0 := histogram[0]; end; kx := kx + kdelta; ky := ky + kdelta; yb := yb + kh; end; if hist0 <> 0 then PutMessage('Incomplete convolution -- Results not reliable'); swapTemp16; hide8Image; writeln('masked smooth'); end; macro '[3]Load a new image'; begin fixCopyBug; disposePicBugFix(raw16Pid); importIfNeed; minmax16u(proc16Pid, procXmin, procXmax); SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); show16; enhanceStdev; show16; end; macro 'Front 16 bit image is raw data'; begin fixCopyBug; raw16Pid := pidNumber; SetMemo('raw16Pid',raw16Pid); makeScratchIfNeed; CopyRawToProc; hide8Image; writeln('raw data'); end; macro '[*]Convert to 8 bit with min max scaling'; begin fixCopyBug; importIfNeed; minmax16u(proc16Pid, procXmin, procXmax); SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); show16; end; macro '[8]Convert to 8 bit with mean ± stdev scaling'; begin fixCopyBug; importIfNeed; minmax16u(proc16Pid, procXmin, procXmax); SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); show16; enhanceStdev; show16; end; macro '[¥]Enhance ROI of 8 bit image'; begin fixCopyBug; importIfNeed; enhanceStdev; show16; end; macro '[9]reduce xmin'; begin fixCopyBug; importIfNeed; procXmin := round(procXmin - 0.1*(procXmax - procXmin) - 1); if procXmin > procXmax then procXmax := procXmin + 1; SetMemo('procXmin',procXmin); show16; end; macro '[»]increase xmin'; begin fixCopyBug; importIfNeed; procXmin := round(procXmin + 0.1*(procXmax - procXmin) + 1); if procXmin > procXmax then procXmax := procXmin + 1; SetMemo('procXmin',procXmin); show16; end; macro '[0]reduce xmax'; begin fixCopyBug; importIfNeed; procXmax := round(procXmax - 0.1*(procXmax - procXmin) - 1); if procXmax < procXmin then procXmin := procXmax - 1; SetMemo('procXmin',procXmin); show16; end; macro '[¼]increase xmax'; begin fixCopyBug; importIfNeed; procXmax := round(procXmax + 0.1*(procXmax - procXmin) + 1); if procXmin > procXmax then procXmin := procXmax - 1; SetMemo('procXmin',procXmin); show16; end; macro 'remove calibration on 8 bit image'; begin fixCopyBug; forceUncalib; end; macro 'Show calibration numbers'; begin fixCopyBug; ShowMessage('Analyze/optionCalibrate... straight line', '\(hold option key while selecting Calibrate)', '\measured ',ymin,' known ',procXmin, '\measured ',ymax,' known ',procXmax); setCounter(2); end; macro 'rename front image'; begin fixCopyBug; SetPicName(GetString('new image name',GetPicName)); end; macro 'Hilight marked areas in sequence'; var fg, i: integer; begin fixCopyBug; fg := pidNumber; selectPicBugFix(seg8aPid); killRoi; SetOptions(''); measure; for i := 1 to 254 do begin if histogram[i] <> 0 then begin setDensitySlice(i,i); showMessage('Mark number ',i:0); KillDelay(1); StartDelay(1,1.0); WaitDelay(1); end; end; setDensitySlice(0,0); selectPicBugFix(fg); end; macro '[g] Show processed 8 bit image'; begin fixCopyBug; selectPicBugFix(proc8Pid); end; procedure adjustFore(offset: integer); var wrap: integer; begin if offset < 0 then wrap := 250 else wrap := 1; fore := fore + offset; if fore > 250 then fore := wrap; if fore < 1 then fore := wrap; setMemo('fore',fore); end; macro '[h]Hilight previous segment'; var oldFore: integer; begin fixCopyBug; adjustFore(0); oldFore := fore; selectPicBugFix(seg8aPid); killRoi; measure; SetCounter(rCount - 1); repeat adjustFore(-1); until (histogram[fore] <> 0) or (fore = oldFore); setDensitySlice(fore,fore); ShowMessage('Hilight color is ',fore); end; macro '[j] Hilight next segment'; var oldFore: integer; begin fixCopyBug; adjustFore(0); oldFore := fore; selectPicBugFix(seg8aPid); killRoi; measure; SetCounter(rCount - 1); repeat adjustFore(1); until (histogram[fore] <> 0) or (fore = oldFore); setDensitySlice(fore,fore); ShowMessage('Hilight color is ',fore); end; procedure appendROI; var fg, lower,upper: integer; begin fg := pidNumber; GetThreshold(lower,upper); SetDensitySlice(0,0); KillRoi; RestoreRoi; Clear; ChoosePic(seg8aPid); SetBackgroundColor(0); SetForegroundColor(fore); RestoreRoi; fill; SetForegroundColor(255); selectPicBugFix(fg); ShowMessage('Hilight color is ',fore,'\lower',lower,'\upper',upper); if upper = 255 then SetThreshold(lower) else SetDensitySlice(lower,upper); end; macro '[n]ROI is next segment'; begin fixCopyBug; adjustFore(1); appendROI; SelectPicBugFix(pidNumber); end; macro '[m]append ROI to segment'; begin fixCopyBug; appendROI; SelectPicBugFix(pidNumber); end; macro 'dilate segments A onto segments B'; var r: integer; width,height: integer; begin fixCopyBug; choosePic(seg8aPid); r := GetNumber('dilation radius',5); SelectAll; Copy; InsetRoi(r+1); choosePic(seg8bPid); SelectAll; Paste; InsetRoi(r+1); Dilate8Circular(seg8aPid, seg8bPid, r); choosePic(seg8aPid); KillRoi; selectPicBugFix(seg8bPid); KillRoi; end; macro 'copy segments B onto segments A'; begin fixCopyBug; choosePic(seg8bPid); SelectAll; Copy; KillRoi; selectPicBugFix(seg8aPid); SelectAll; Paste; KillRoi; end; macro 'Tabulate intensities using segments A'; var i, k, x, y, z: integer; sumPid, areaPid: integer; xlatePid: integer; begin fixCopyBug; SaveState; SetNewSize(32,32); MakeNewWindow('Sums'); sumPid := pidNumber; MakeNewWindow('Areas'); areaPid := pidNumber; {***fill temp16Pid with ones***} SetNewSize(512, 1); SetBackgroundColor(0); MakeNewWindow('8 to 16 conversion table'); xlatePid := pidNumber; for i := 0 to 255 do putpixel(i * 2, 0, 1); {translate anything to 1} MakeRoi(0, 0, 512, 1); ChoosePic(seg8aPid); killRoi; ChoosePic(temp16Pid); killRoi; Cnvrt8to16u(seg8aPid, xlatePid, temp16Pid); disposePicBugFix(xlatePid); Sum16sMark(proc16Pid,seg8aPid,sumPid); Sum16sMark(temp16Pid,seg8aPid,areaPid); {also need standard deviation, min, max} ResetCounter; SetOptions('area,user1,user2'); x := 0; for k := 1 to 256 do begin y := GetPixVec32s(areaPid,k); z := GetPixVec32s(sumPid,k); if y <> 0 then begin x := x + 1; SetCounter(x); rUser1[x] := k;{segment number} rArea[x] := y; {area} rUser2[x] := z;{sum} end; end; disposePicBugFix(sumPid); disposePicBugFix(areaPid); SetUser1Label('segment'); SetUser2Label('sum'); ShowResults; RestoreState; SelectPicBugFix(pidNumber); end;